home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue32 / dirtree / DIRTREE.ZIP / main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-29  |  7.4 KB  |  216 lines
  1.  
  2. {sample for TDirTree; see dirtree.pas for details}
  3.  
  4. unit main;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  10.   ComCtrls, dirtree, StdCtrls, FileCtrl, ExtCtrls,shellapi;
  11.  
  12. type
  13.   TForm1 = class(TForm)
  14.     Panel1: TPanel;
  15.     Image1: TImage;
  16.     Panel2: TPanel;
  17.     Label1: TLabel;
  18.     CheckBox1: TCheckBox;
  19.     DriveComboBox1: TDriveComboBox;
  20.     GroupBox1: TGroupBox;
  21.     CheckBox2: TCheckBox;
  22.     CheckBox3: TCheckBox;
  23.     CheckBox4: TCheckBox;
  24.     CheckBox5: TCheckBox;
  25.     CheckBox6: TCheckBox;
  26.     CheckBox7: TCheckBox;
  27.     Panel3: TPanel;
  28.     ListView1: TListView;
  29.     Panel4: TPanel;
  30.     Panel5: TPanel;
  31.     Button1: TButton;
  32.     Button2: TButton;
  33.     Label2: TLabel;
  34.     Edit1: TEdit;
  35.     Button3: TButton;
  36.     procedure DirTree1AddDir(Filename: string; var DoAdd: Boolean);
  37.     procedure DirTree1Change(Sender: TObject; Node: TTreeNode);
  38.     procedure DriveComboBox1Change(Sender: TObject);
  39.     procedure CheckBox1Click(Sender: TObject);
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure FormDestroy(Sender: TObject);
  42.     procedure FormActivate(Sender: TObject);
  43.     procedure Button1Click(Sender: TObject);
  44.     procedure Image1Click(Sender: TObject);
  45.     procedure CheckBox2Click(Sender: TObject);
  46.     procedure Button2Click(Sender: TObject);
  47.     procedure Button3Click(Sender: TObject);
  48.     procedure dragover(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  49.     procedure dragdrop(Sender, Source: TObject; X, Y: Integer);
  50.   private
  51.     { Private-Deklarationen }
  52.   public
  53.     { Public-Deklarationen }
  54.     procedure reloadlistview; // read the files in the listview
  55.   end;
  56.  
  57. var
  58.   Form1: TForm1;
  59.   dirtree1 : tdirtree; // this is our tdirtree-component (here as an object)
  60.   allowchange : boolean = true;
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. procedure TForm1.DirTree1AddDir(Filename: string; var DoAdd: Boolean);
  66. begin
  67.      if checkbox1.checked then
  68.      if upcase(filename[1]) <> upcase(drivecombobox1.drive) then doadd := false;
  69.      // add only folders descending from the selected drive
  70. end;
  71.  
  72. procedure TForm1.DirTree1Change(Sender: TObject; Node: TTreeNode);
  73. begin
  74.      caption := Dirtree1.directory;
  75.      allowchange := upcase (dirtree1.drive) = upcase(drivecombobox1.drive);
  76.      drivecombobox1.drive := dirtree1.drive;
  77.      reloadlistview;
  78. end;
  79.  
  80. procedure TForm1.DriveComboBox1Change(Sender: TObject);
  81. begin
  82.      if not allowchange then begin
  83.         allowchange := true;
  84.         exit;
  85.      end;
  86.      dirtree1.drive := drivecombobox1.drive;
  87.      if checkbox1.checked then dirtree1.reload;
  88.         // show directorys of a different drive
  89. end;
  90.  
  91. procedure TForm1.CheckBox1Click(Sender: TObject);
  92. begin
  93.      dirtree1.reload; // mode has changed (see onadddir)  therefore re-read the items
  94. end;
  95.  
  96. procedure TForm1.FormCreate(Sender: TObject);
  97. begin
  98.      dirtree1 := tdirtree.create(self);
  99.      dirtree1.align := alleft;
  100.      dirtree1.width := 200;
  101.      dirtree1.onchange := dirtree1change;
  102.      dirtree1.onadddir := dirtree1adddir;
  103.      dirtree1.parent := self;
  104.      dirtree1.ondragover := dragover;
  105.      dirtree1.ondragdrop := dragdrop;
  106.  
  107.      // now set the listview's small icons to dirtree1's shellicons to display the shell-given
  108.      // icons in the listview;
  109.      listview1.smallimages := dirtree1.shellicons;
  110. end;
  111.  
  112. procedure TForm1.FormDestroy(Sender: TObject);
  113. begin
  114.      dirtree1.free;
  115. end;
  116.  
  117. procedure TForm1.FormActivate(Sender: TObject);
  118. var c :char;
  119. begin
  120.      c := drivecombobox1.drive;
  121.      dirtree1.drive := c;
  122. end;
  123.  
  124. procedure TForm1.Button1Click(Sender: TObject);
  125. begin
  126.      dirtree1.fullexpand;
  127. end;
  128.  
  129. procedure TForm1.Image1Click(Sender: TObject);
  130. begin
  131.      if ShellExecute(Application.Handle,PChar('open'),PChar('http://home.t-online.de/home/mirbir.st/'),PChar(''),nil,SW_NORMAL) < 33 then
  132.      if ShellExecute(Application.Handle,PChar('open'),PChar('netscape.exe'),PChar('http://home.t-online.de/home/mirbir.st/'),nil,SW_NORMAL) < 32 then
  133.      if ShellExecute(Application.Handle,PChar('open'),PChar('iexplore.exe'),PChar('http://home.t-online.de/home/mirbir.st/'),nil,SW_NORMAL) < 32 then
  134.         showmessage ('Please visit me at : http://home.t-online.de/home/mirbir.st');
  135. end;
  136.  
  137. procedure TForm1.CheckBox2Click(Sender: TObject);
  138. var ds : tdirtype;
  139. begin
  140.       ds := [];
  141.       if checkbox2.checked then ds:=ds+[dthidden];
  142.       if checkbox3.checked then ds:=ds+[dtsystem];
  143.       if checkbox4.checked then ds:=ds+[dtarchive];
  144.       if checkbox5.checked then ds:=ds+[dtreadonly];
  145.       if checkbox6.checked then ds:=ds+[dtnormal];
  146.       if checkbox7.checked then ds:=ds+[dtall];
  147.       dirtree1.dirtype := ds;
  148. end;
  149.  
  150. procedure TForm1.Button2Click(Sender: TObject);
  151. begin
  152.      dirtree1.reload;
  153.      reloadlistview;
  154. end;
  155. procedure tform1.reloadlistview; // read the files in the listview
  156. var srec : tsearchrec ; // record for findfirst/next
  157.     sfi : tshfileinfo;  // record-structure for shgetfileinfo
  158.     res : integer;
  159.     str,dir : string;
  160. begin
  161.      with listview1 do begin
  162.           // do not show the changes until all of them are done
  163.           items.beginupdate;
  164.           // clear all items
  165.           items.clear;
  166.           dir := dirtree1.directory;
  167.           // if not a \ at the end, add it there
  168.           if dir[length(dir)] <> '\' then dir:=dir+'\';
  169.           // add the file-mask (*.* by default);
  170.           str:=dir+edit1.text;
  171.           // now begin with findfirst/next
  172.           fillchar(srec,sizeof(tsearchrec),0); // fill the structure with zero-bytes (make it clean)
  173.           res := findfirst(str,faanyfile-favolumeid-fadirectory,srec);
  174.           // if res = 0 then a file has been found
  175.           while res = 0 do begin
  176.                 // now get the displayname ( like the shell : with/without extension)
  177.                 // and the sysiconindex (this is the index of the file's associated icon in
  178.                 // the sytem's image list; and we have this list in dirtree1.shellicons and
  179.                 // therefore in the listview's smallimages, too (formcreate)
  180.                 fillchar(sfi,sizeof(tshfileinfo),0); // delete the rubbish
  181.                 // this api does the /\ described things
  182.                 shgetfileinfo(pchar(dir+srec.name) { the full file-name},0 {dwattributes (not used here)},
  183.                   sfi {contains the resulting info}, sizeof(tshfileinfo),
  184.                   shgfi_displayname {get the shell-displayed file-name} or
  185.                   shgfi_sysiconindex {what could it be ?});
  186.                 // and now add a new item with the resulting parameters to the listview
  187.                 with {listview1.}items.add do begin
  188.                      caption := sfi.szdisplayname; // the displayname-result in the sfi-struct
  189.                      imageindex := sfi.iicon; // the sysiconindex-result in sfi
  190.                 end;
  191.                 res := findnext(srec); // read next file and close loop;
  192.           end;
  193.           // at last show the changes
  194.           items.endupdate;
  195.      end;
  196. end;
  197.  
  198. procedure TForm1.Button3Click(Sender: TObject);
  199. begin
  200.      reloadlistview;
  201.  
  202. end;
  203.  
  204. // drag'n'drop-handling
  205. procedure tform1.dragover(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  206. begin
  207.      if sender = listview1 then accept := true;
  208. end;
  209.  
  210. procedure tform1.dragdrop(Sender, Source: TObject; X, Y: Integer);
  211. begin
  212.      showmessage('Dropped to : '+dirtree1.dropdirectory);
  213. end;
  214.  
  215. end.
  216.